
* This file contains Stata script that replicates the results reported in 
* Montag, Josef, and James Tremewan. "Let the Punishment Fit the Criminal: An
* Experimental Study." 

* Authors: 

* Josef Montag | josef.montag@gmail.com
* International School of Economics
* Kazakh-British Technical University

* James Tremewan | james.tremewan@wu.ac.at@gmail.com
* Vienna University of Economics and Business, and  
* Vienna Center for Experimental Economics, University of Vienna 

* September 16, 2017 

* The script reproduces Tables 2 to 4 and A1 and A2.

* The main database is "data_level_partner.dta," which is an output of the
* script "Data_Prepare.R" and is located in folder "Data."

* The script was tested to work in Stata 12 and 13.

* This code requires installed "estout.ado" package to run properly

* -------------------------------
* SET PRELIMINARIES AND LOAD DATA {{{1
* -------------------------------

* NOTE: Change working directory to the one where this do-file is located.

log using 4_Stata_Log_20170916.txt, text

clear
set more off
set seed 42 // For exact replicability of bootstrapped standard errors

use Data\data_level_partner.dta

egen RoleA_id = group(id)
xtset RoleA_id // Set Role B as Group Variable for RE models

* ---------------------------------------------------------------
* Set GLOBALS FOR COVARIATES, COVARIATE LABELS, AND OTHER OPTIONS {{{1
* ---------------------------------------------------------------

global RoleAchars PartnersEarnings PartnersWealth PartnersWTP
global RoleAcharsFlex PartnersEarnings25 PartnersEarnings50 PartnersWealth25 ///
                      PartnersWealth50 PartnersWTP
global RoleBchars bonus randwealth wtp donate age female crt Qpolitics
global tableprefs se star(* 0.10 ** 0.05 *** 0.01) b(2) varwidth(32)
global drop drop(sigma_u: sigma_e:) 
global stats stats(N N_g, labels("\addlinespace Number of observations" ///
                                 "\addlinespace Number of Role B subjects") ///
                   fmt(a3 a3))
global coeflabels ///
  coeflabels(PartnersEarnings "RoleAlabel Slider Task Bonus" ///
             PartnersWealth "Random Payment" ///
             PartnersWTP "Willingness to Pay" ///
             bonus "RoleBlabel Slider Task Bonus" ///
             randwealth "Random Payment" ///
             wtp "Willingness to Pay" ///
             donate "Donation decision" ///
             age Age ///
             female "Female (=1)" ///
             Qpolitics "Political views (0-5)" ///
             crt "Cognitive Reflection Test (0-3)" ///
             Sliders "Non-monetary treatment (=1)" ///
             PartnersEarnings25 "RoleAlabel Slider Task Bonus = \euro 2.5" ///
             PartnersEarnings50 "Slider Task Bonus = \euro 5" ///
             PartnersWealth25 "Random Payment = \euro 2.5" ///
             PartnersWealth50 "Random Payment = \euro 5" ///
             _cons Constant)

global vceonoff vce(boot, reps(10000))

* ----------------------------------------------
* TABLE 2: Subjective Determinants of Punishment {{{1
* ----------------------------------------------

eststo clear

* Monetary:
eststo m1:  qui xttobit proppunish_1 $RoleAchars if Sliders==0, ll(0) ul(100) $vceonoff
eststo m2:  qui xttobit proppunish_2 $RoleAchars if Sliders==0, ll(0) ul(100) $vceonoff
eststo m3:  qui xttobit proppunish_3 $RoleAchars if Sliders==0, ll(0) ul(100) $vceonoff
* Non-monetary:
eststo nm1: qui xttobit proppunish_1 $RoleAchars if Sliders==1, ll(0) ul(100) $vceonoff
eststo nm2: qui xttobit proppunish_2 $RoleAchars if Sliders==1, ll(0) ul(100) $vceonoff
eststo nm3: qui xttobit proppunish_3 $RoleAchars if Sliders==1, ll(0) ul(100) $vceonoff

esttab m1 m2 m3 nm1 nm2 nm3, $tableprefs $stats $coeflabels $drop

* ------------------------------------------
* TABLE 3: Testing Effects Across Treatments {{{1 
* ------------------------------------------

foreach s in 1 2 3 {
  est restore m`s'
    local b_earns0   = _b[PartnersEarnings] 
    local b_wealth0  = _b[PartnersWealth] 
    local b_wtp0     = _b[PartnersWTP] 
    local se_earns0  = _se[PartnersEarnings] 
    local se_wealth0 = _se[PartnersWealth] 
    local se_wtp0    = _se[PartnersWTP] 
  est restore nm`s'
    local b_earns1   = _b[PartnersEarnings] 
    local b_wealth1  = _b[PartnersWealth] 
    local b_wtp1     = _b[PartnersWTP] 
    local se_earns1  = _se[PartnersEarnings] 
    local se_wealth1 = _se[PartnersWealth] 
    local se_wtp1    = _se[PartnersWTP] 
  if `s' == 1 {
    di
    di "1. DECISION: Take All"
    di 
  } 
  else if `s' == 2 {
    di
    di "2. DECISION: Take Half"
    di 
  } 
  else {
    di
    di "3. DECISION: Do Nothing"
    di 
  } 
  * Tests across treatments
  local z_earns  (`b_earns0' - `b_earns1') / sqrt(`se_earns0'^2 + `se_earns1'^2)
  local p_earns  1 - normal(abs(`z_earns'))
  local z_wealth (`b_wealth0' - `b_wealth1') / sqrt(`se_wealth0'^2 + `se_wealth1'^2)
  local p_wealth 1 - normal(abs(`z_wealth'))
  local z_wtp    (`b_wtp1' - `b_wtp0')    / sqrt(`se_wtp0'^2    + `se_wtp1'^2)
  local p_wtp    1 - normal(abs(`z_wtp'))
  di "Testing effects across treatments"
  di
  di "Earnings z-score: " round(`z_earns', 0.01)
  di "         p-value: " round(`p_earns', 0.001)
  di "Rand. w. z-score: " round(`z_wealth', 0.01)
  di "         p-value: " round(`p_wealth', 0.001)
  di "WTP      z-score: " round(`z_wtp', 0.01)
  di "         p-value: " round(`p_wtp', 0.001)
  di
  * Tests of earned v. random wealth
  local z_EWvRW0  (`b_wealth0' - `b_earns0') / sqrt(`se_wealth0'^2 + `se_earns0'^2)
  local p_EWvRW0  1 - normal(abs(`z_EWvRW0'))
  local z_EWvRW1  (`b_wealth1' - `b_earns1') / sqrt(`se_wealth1'^2 + `se_earns1'^2)
  local p_EWvRW1  1 - normal(abs(`z_EWvRW1'))
  di "Testing Random Wealth vs Earnings"
  di
  di "Monetary treatment:"
  di "z-score: " round(`z_EWvRW0', 0.01)
  di "p-value: " round(`p_EWvRW0', 0.001)
  di "Non-monetary treatment:"
  di "z-score: " round(`z_EWvRW1', 0.01)
  di "p-value: " round(`p_EWvRW1', 0.001)
}

* ----------------------------------------------------------------
* TABLE 4: The Effects of Role of Role B's Own Decisions and Chars {{{1
* ----------------------------------------------------------------

eststo clear

* Monetary:
eststo: qui xttobit proppunish_1 $RoleAchars $RoleBchars if Sliders==0, ll(0) ul(100)   $vceonoff
eststo: qui xttobit proppunish_2 $RoleAchars $RoleBchars if Sliders==0, ll(0) ul(100)   $vceonoff
eststo: qui xttobit proppunish_3 $RoleAchars $RoleBchars if Sliders==0, ll(0) ul(100)   $vceonoff
* Non-monetary:
eststo: qui xttobit proppunish_1 $RoleAchars $RoleBchars if Sliders==1, ll(0) ul(100) $vceonoff
eststo: qui xttobit proppunish_2 $RoleAchars $RoleBchars if Sliders==1, ll(0) ul(100) $vceonoff
eststo: qui xttobit proppunish_3 $RoleAchars $RoleBchars if Sliders==1, ll(0) ul(100) $vceonoff

esttab est*, $tableprefs $stats $coeflabels $drop

* ----------------------------------------
* TABLE A1: Flexible monetary determinants {{{1
* ----------------------------------------

eststo clear

* Monetary:
eststo: qui xttobit proppunish_1 $RoleAcharsFlex if Sliders==0, ll(0) ul(100) $vceonoff
eststo: qui xttobit proppunish_2 $RoleAcharsFlex if Sliders==0, ll(0) ul(100) $vceonoff
eststo: qui xttobit proppunish_3 $RoleAcharsFlex if Sliders==0, ll(0) ul(100) $vceonoff
* Non-monetary:
eststo: qui xttobit proppunish_1 $RoleAcharsFlex if Sliders==1, ll(0) ul(100) $vceonoff
eststo: qui xttobit proppunish_2 $RoleAcharsFlex if Sliders==1, ll(0) ul(100) $vceonoff
eststo: qui xttobit proppunish_3 $RoleAcharsFlex if Sliders==1, ll(0) ul(100) $vceonoff

esttab est*, $tableprefs $stats $coeflabels $drop

* -------------------------------------------------------------
* TABLE A2: Adjusted punishments on treatment with Role B chars {{{1
* -------------------------------------------------------------

eststo clear

* Monetary equivalents:
eststo: qui xtreg punoptions_1adj Sliders $RoleBchars, vce(cluster id)
eststo: qui xtreg punoptions_2adj Sliders $RoleBchars, vce(cluster id)
eststo: qui xtreg punoptions_3adj Sliders $RoleBchars, vce(cluster id)
* Proportions of max:
eststo: qui xtreg proppunish_1    Sliders $RoleBchars, vce(cluster id)
eststo: qui xtreg proppunish_2    Sliders $RoleBchars, vce(cluster id)
eststo: qui xtreg proppunish_3    Sliders $RoleBchars, vce(cluster id)

esttab est*, $tableprefs $stats $coeflabels

log close
